home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / May / di9805fn / StrTst02.pas < prev    next >
Pascal/Delphi Source File  |  1998-01-13  |  5KB  |  185 lines
  1. unit StrTst02;
  2. { Related to my File|New Column on AnsiStrings in Delphi Informant, May, 1998.
  3.   This project demonstrates routines in the HyperString library from
  4.   EFD Systems.  To download the free Delphi 3 *.dcu (HSTR.ZIP) needed
  5.   to run this program, visit their Web Site at www.mindspring.com/~efd.
  6.   Also, be sure to read the paper on AnsiStrings while you're there.
  7.   To report bugs or make suggestions, please E-Mail me at acmdoc@aol.com.
  8.   Thanks, and enjoy!  Alan C. Moore }
  9.  
  10. interface
  11.  
  12. uses
  13.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  14.   StdCtrls, Buttons;
  15.  
  16. type
  17.   TForm1 = class(TForm)
  18.     BitBtn1: TBitBtn;
  19.     Edit1: TEdit;
  20.     Edit2: TEdit;
  21.     Edit3: TEdit;
  22.     Edit4: TEdit;
  23.     Edit5: TEdit;
  24.     Edit6: TEdit;
  25.     Edit7: TEdit;
  26.     Edit8: TEdit;
  27.     Edit9: TEdit;
  28.     Edit15: TEdit;
  29.     Edit16: TEdit;
  30.     Edit17: TEdit;
  31.     Edit18: TEdit;
  32.     Label1: TLabel;
  33.     Label2: TLabel;
  34.     Label3: TLabel;
  35.     Label4: TLabel;
  36.     Label5: TLabel;
  37.     Label6: TLabel;
  38.     Label7: TLabel;
  39.     Label8: TLabel;
  40.     Label9: TLabel;
  41.     Label15: TLabel;
  42.     Label16: TLabel;
  43.     Label17: TLabel;
  44.     Label18: TLabel;
  45.     Label19: TLabel;
  46.     Memo1: TMemo;
  47.     ActiveWindowsBtn: TButton;
  48.     ListBox1: TListBox;
  49.     WindowsClassesBtn: TButton;
  50.     Label10: TLabel;
  51.     Label11: TLabel;
  52.     Edit10: TEdit;
  53.     Label12: TLabel;
  54.     Edit11: TEdit;
  55.     Label13: TLabel;
  56.     Edit12: TEdit;
  57.     Label14: TLabel;
  58.     Edit13: TEdit;
  59.     procedure FormCreate(Sender: TObject);
  60.     procedure ActiveWindowsBtnClick(Sender: TObject);
  61.     procedure WindowsClassesBtnClick(Sender: TObject);
  62.     procedure Label18Click(Sender: TObject);
  63.   private
  64.     { Private declarations }
  65.   public
  66.     { Public declarations }
  67.     ComStrings : TStrings;
  68.     procedure ListAllClasses;
  69.     procedure ListAllWindows;
  70.     procedure GetCurrentMemory;
  71.   end;
  72.  
  73. var
  74.   Form1: TForm1;
  75.  
  76. implementation
  77. uses HyperStr;
  78. {$R *.DFM}
  79.  
  80. procedure TForm1.FormCreate(Sender: TObject);
  81. var
  82.   Drv : char;
  83.   VolName,
  84.   FSys,
  85.   Path,
  86.   Prefix,
  87.   LongName,
  88.   Title,
  89.   Name: string;
  90.   VolSize : DWord;
  91.  
  92. begin
  93.   if GetUser='' then Edit1.Text := 'None' else
  94.      Edit1.Text := GetUser;
  95.   if GetNetUser='' then Edit2.Text := 'None' else
  96.      Edit2.Text := GetNetUser;
  97.   Edit3.Text := GetComputer;
  98.   Edit4.Text := GetDrives;
  99.   Drv := 'F';   {Often used as Network Drive; Substitute your network drive}
  100.   if RemoteDrive(Drv) then Edit5.Text := Drv
  101.      else Edit5.Text := 'None';
  102.   if GetVolume('C',  VolName,  FSys, VolSize) then
  103.      Edit6.Text := VolName;
  104.   Edit7.Text := GetWinDir;
  105.   Edit8.Text := GetSysDir;
  106.   Edit9.Text := GetTmpDir;
  107.   Edit15.Text := GetCPU;
  108.   Edit16.Text := GetDefaultPrn;
  109.   if IsWinNT then
  110.      Edit17.Text := 'Yes' else
  111.      Edit17.Text := 'No';
  112.      Edit13.Text :=GetKeyValues(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion',
  113.                    'Version,VersionNumber,RegisteredOwner,RegisteredOrganization,ProductId');
  114.   GetComList(Memo1.Lines);
  115.   GetCurrentMemory;
  116.  
  117. end;
  118.  
  119. procedure TForm1.GetCurrentMemory;
  120. var
  121.   RAMTotal,
  122.   RAMUsed,
  123.   PGTotal,
  124.   PGUsed:Integer;
  125. begin
  126.   GetMemStatus(RAMTotal, RAMUsed, PGTotal, PGUsed);
  127.   Edit18.Text := IntToStr(RAMTotal);
  128.   Edit10.Text := IntToStr(RAMUsed);
  129.   Edit11.Text := IntToStr(PGTotal);
  130.   Edit12.Text := IntToStr(PGUsed);
  131. end;
  132.  
  133. procedure TForm1.ListAllWindows;   {Based on Example from HyperStr Help File}
  134. //Retrieve all active windowss and parse them into a listbox
  135. var
  136.   S,T,X:AnsiString;
  137.   I:Integer;
  138. begin
  139.   ListBox1.Clear;
  140.   SetDelimiter(#44); //use a comma delimiter
  141.   S:=GetWindows;     // HyperStr function
  142.   I:=1;
  143.   repeat
  144.     X:=Parse(S,#44,I);   //! ',' doesn't work for param 2
  145.     if Length(X)>0 then ListBox1.Items.Add(X);
  146.   until I=0;
  147.  
  148. end;
  149.  
  150. procedure TForm1.ListAllClasses; {Based on Example from HyperStr Help File}
  151. //Retrieve all class names and parse them into a listbox
  152. var
  153.   S,T,X:AnsiString;
  154.   I:Integer;
  155. begin
  156.   ListBox1.Clear;
  157.   SetDelimiter(#44); //use a comma delimiter
  158.   S:=GetClasses;     // HyperStr function
  159.   I:=1;
  160.   repeat
  161.     X:=Parse(S,#44,I);   //! ',' doesn't work for param 2
  162.     if Length(X)>0 then ListBox1.Items.Add(X);
  163.   until I=0;
  164.  
  165. end;
  166.  
  167.  
  168.  
  169. procedure TForm1.ActiveWindowsBtnClick(Sender: TObject);
  170. begin
  171.   ListAllWindows;
  172. end;
  173.  
  174. procedure TForm1.WindowsClassesBtnClick(Sender: TObject);
  175. begin
  176.   ListAllClasses;
  177. end;
  178.  
  179. procedure TForm1.Label18Click(Sender: TObject);
  180. begin
  181.   GetCurrentMemory;
  182. end;
  183.  
  184. end.
  185.